home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / perl5a1.lha / perl5alpha1 / do / subr < prev    next >
Encoding:
Text File  |  1992-08-15  |  2.3 KB  |  92 lines
  1. int
  2. do_subr(arg,gimme,arglast)
  3. register ARG *arg;
  4. int gimme;
  5. int *arglast;
  6. {
  7.     register STR **st = stack->ary_array;
  8.     register int sp = arglast[1];
  9.     register int items = arglast[2] - sp;
  10.     register SUBR *sub;
  11.     SPAT * VOL oldspat = curspat;
  12.     STR *TARG;
  13.     STAB *stab;
  14.     int oldsave = savestack->ary_fill;
  15.     int oldtmps_base = tmps_base;
  16.     int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
  17.     register CSV *csv;
  18.  
  19.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  20.     stab = arg[1].arg_ptr.arg_stab;
  21.     else {
  22.     STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  23.  
  24.     if (tmpstr)
  25.         stab = stabent(str_get(tmpstr),TRUE);
  26.     else
  27.         stab = Nullstab;
  28.     }
  29.     if (!stab)
  30.     fatal("Undefined subroutine called");
  31.     if (!(sub = stab_sub(stab))) {
  32.     STR *tmpstr = arg[0].arg_ptr.arg_str;
  33.  
  34.     stab_efullname(tmpstr, stab);
  35.     fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
  36.     }
  37.     if (arg->arg_type == O_DBSUBR && !sub->usersub) {
  38.     TARG = stab_val(DBsub);
  39.     saveitem(TARG);
  40.     stab_efullname(TARG,stab);
  41.     sub = stab_sub(DBsub);
  42.     if (!sub)
  43.         fatal("No DBsub routine");
  44.     }
  45.     TARG = Str_new(15, sizeof(CSV));
  46.     TARG->str_state = SS_SCSV;
  47.     (void)apush(savestack,TARG);
  48.     csv = (CSV*)TARG->str_ptr;
  49.     csv->sub = sub;
  50.     csv->stab = stab;
  51.     csv->oldcsv = curcsv;
  52.     csv->oldcmd = curcmd;
  53.     csv->depth = sub->depth;
  54.     csv->wantarray = gimme;
  55.     csv->hasargs = hasargs;
  56.     curcsv = csv;
  57.     tmps_base = tmps_max;
  58.     if (sub->usersub) {
  59.     csv->hasargs = 0;
  60.     csv->savearray = Null(ARRAY*);;
  61.     csv->argarray = Null(ARRAY*);
  62.     st[sp] = ARGTARG;
  63.     if (!hasargs)
  64.         items = 0;
  65.     sp = (*sub->usersub)(sub->userindex,sp,items);
  66.     }
  67.     else {
  68.     if (hasargs) {
  69.         csv->savearray = stab_xarray(defstab);
  70.         csv->argarray = afake(defstab, items, &st[sp+1]);
  71.         stab_xarray(defstab) = csv->argarray;
  72.     }
  73.     sub->depth++;
  74.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  75.         if (sub->depth == 100 && dowarn)
  76.         warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
  77.         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  78.     }
  79.     sp = cmd_exec(sub->cmd,gimme, --sp);    /* so do it already */
  80.     }
  81.  
  82.     st = stack->ary_array;
  83.     tmps_base = oldtmps_base;
  84.     for (items = arglast[0] + 1; items <= sp; items++)
  85.     st[items] = str_mortal(st[items]);
  86.         /* in case restore wipes old TARG */
  87.     restorelist(oldsave);
  88.     curspat = oldspat;
  89.     return sp;
  90. }
  91.  
  92.